home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / w3 / base64.el next >
Encoding:
Text File  |  1995-05-10  |  5.1 KB  |  153 lines
  1. ;;; base64.el,v --- Base64 encoding functions
  2. ;; Author: wmperry
  3. ;; Created: 1995/05/07 14:34:47
  4. ;; Version: 1.3
  5. ;; Keywords: extensions
  6.  
  7. ;;; LCD Archive Entry:
  8. ;;; base64.el|William M. Perry|wmperry@spry.com|
  9. ;;; Package for encoding/decoding base64 data|
  10. ;;; 1995/05/07 14:34:47|1.3|Location Undetermined
  11. ;;;
  12.  
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ;;; Base 64 encoding functions
  15. ;;; This code was converted to lisp code by me from the C code in
  16. ;;; ftp://cs.utk.edu/pub/MIME/b64encode.c
  17. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18.  
  19. (defvar base64-encoding
  20.  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  21.  "The string to use to encode with base 64.")
  22.  
  23. (defvar base64-max-line-length 64)
  24.  
  25. ;(defun b0 (x) (aref base64-encoding (logand (lsh x -18) 63)))
  26. ;(defun b1 (x) (aref base64-encoding (logand (lsh x -12) 63)))
  27. ;(defun b2 (x) (aref base64-encoding (logand (lsh x -6) 63)))
  28. ;(defun b3 (x) (aref base64-encoding (logand x 63)))
  29.  
  30. (defmacro b0 (x) (` (aref base64-encoding (logand (lsh (, x) -18) 63))))
  31. (defmacro b1 (x) (` (aref base64-encoding (logand (lsh (, x) -12) 63))))
  32. (defmacro b2 (x) (` (aref base64-encoding (logand (lsh (, x) -6) 63))))
  33. (defmacro b3 (x) (` (aref base64-encoding (logand (, x) 63))))
  34.  
  35. (defun base64-encode (str)
  36.   "Do base64 encoding on string STR and return the encoded string.
  37. This code was converted to lisp code by me from the C code in
  38. ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns a string that is
  39. broken into `base64-max-line-length' byte lines."
  40.   (or str (setq str (buffer-string)))
  41.   (let ((x (base64-encode-internal str))
  42.     (y ""))
  43.     (while (> (length x) base64-max-line-length)
  44.       (setq y (concat y (substring x 0 base64-max-line-length) "\n")
  45.         x (substring x base64-max-line-length nil)))
  46.     (setq y (concat y x))
  47.     y))
  48.  
  49. (defun base64-encode-internal (str)
  50.   "Do base64 encoding on string STR and return the encoded string.
  51. This code was converted to lisp code by me from the C code in
  52. ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns the entire string,
  53. not broken up into `base64-max-line-length' byte lines."
  54.   (let (
  55.     (word 0)            ; The word to translate
  56.     w1 w2 w3
  57.     )
  58.     (cond
  59.      ((> (length str) 3)
  60.       (concat
  61.        (base64-encode-internal (substring str 0 3))
  62.        (base64-encode-internal (substring str 3 nil))))
  63.      ((= (length str) 3)
  64.       (setq w1 (aref str 0)
  65.         w2 (aref str 1)
  66.         w3 (aref str 2)
  67.         word (logior
  68.           (lsh (logand w1 255) 16)
  69.           (lsh (logand w2 255) 8)
  70.           (logand w3 255)))
  71.       (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word)))
  72.      ((= (length str) 2)
  73.       (setq w1 (aref str 0)
  74.         w2 (aref str 1)
  75.         word (logior
  76.           (lsh (logand w1 255) 16)
  77.           (lsh (logand w2 255) 8)
  78.           0))
  79.       (format "%c%c%c=" (b0 word) (b1 word) (b2 word)))
  80.      ((= (length str) 1)
  81.       (setq w1 (aref str 0)
  82.         word (logior
  83.           (lsh (logand w1 255) 16)
  84.           0))
  85.       (format "%c%c==" (b0 word) (b1 word)))
  86.      (t ""))))
  87.  
  88. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  89. ;;; Base64 decoding functions
  90. ;;; This was hacked together by me
  91. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  92. (defun base64-decode-chunk (chunk)
  93.   (let* ((case-fold-search nil)
  94.      (number 
  95.       (+ (lsh (logand 63 (or (string-match (char-to-string (aref chunk 0))
  96.                            base64-encoding) 0)) 18)
  97.          (lsh (logand 63 (or (string-match (char-to-string (aref chunk 1))
  98.                        base64-encoding) 0)) 12)
  99.          (lsh (logand 63 (or (string-match (char-to-string (aref chunk 2))
  100.                        base64-encoding) 0)) 6)
  101.          (logand 63 (or (string-match (char-to-string (aref chunk 3))
  102.                       base64-encoding) 0)))))
  103.     (let ((a (logand (lsh number -16) 255))
  104.       (b (logand (lsh number -8) 255))
  105.       (c (logand number 255))
  106.       (numblanks (if (string-match "==" chunk) 2
  107.                (if (string-match "=" chunk) 1 0))))
  108.       (cond
  109.        ((= numblanks 0)
  110.     (format "%c%c%c" a b c))
  111.        ((= numblanks 1)
  112.     (concat (char-to-string a) (char-to-string b)
  113.         (if (= 0 c) "" (char-to-string c))))
  114.        ((= numblanks 2)
  115.     (concat (char-to-string a)
  116.         (if (= 0 b) "" (char-to-string c))
  117.         (if (= 0 c) "" (char-to-string c))))))))     
  118.  
  119. (defun base64-decode (st &optional nd)
  120.   "Do base64 decoding on string STR and return the original string.
  121. If given buffer positions, destructively decodes that area of the
  122. current buffer."
  123.   (let ((replace-p nil)
  124.     (retval nil))
  125.     (if (stringp st)
  126.     nil
  127.       (setq st (prog1
  128.            (buffer-substring st (or nd (point-max)))
  129.          (delete-region st (or nd (point-max))))
  130.         replace-p t))
  131.     (setq retval
  132.       (save-excursion
  133.         (set-buffer (get-buffer-create " *b64decode*"))
  134.         (erase-buffer)
  135.         (insert st)
  136.         (goto-char (point-min))
  137.         (while (re-search-forward "\r*\n" nil t)
  138.           (replace-match ""))
  139.         (goto-char (point-min))
  140.         (while (not (eobp))
  141.           (let ((chunk (base64-decode-chunk
  142.                 (buffer-substring (point)
  143.                           (progn
  144.                         (forward-char 4)
  145.                         (point))))))
  146.         (backward-delete-char 4)
  147.         (insert chunk)))
  148.         (buffer-string)))
  149.     (if replace-p (insert retval))
  150.     retval))
  151.  
  152. (provide 'base64)
  153.